Zbiór danych zawiera ponad 10 milionów wpisów z pakietu
crimedata. Każdy wpis reprezentuje przestępstwo i jego
okoliczności.
Ja w mojej pracy zajmuję się przestępstwami przeciwko innym ludziom. Rozważam dane z 21 amerykańskich miast w latach 2016-2020.
W swojej pracy przyglądam się kwestii przestępczości.Badam kwestię bezpieczeczeństwa obywateli i turystów. Po lekturze mojej pracy czytelnik dowie się, kiedy jest szczególnie niebezpiecznie w USA, w którym mieście przestępczość jest największa, w jakich porach doby powinniśmy szczególnie na siebie uważać, jaka jest zależność między rodzajem popełnianego przestępstwa, a typem lokalizacji oraz jakie przestępstwo jest najczęściej popełniane w USA. Ponadto przyjrzymy się dokładniej sytuacji w Nowym Yorku.
library("crimedata")
library("tidyr")
library("gapminder")
library("dplyr")
library("mice")
library("ggplot2")
library("knitr")
library("pheatmap")
library("leaflet")
library("leaflet.extras")
W mojej pracy będę używać danych z pakietu crimedata,
pobrałam interesujące mnie dane:
crimes <- readRDS("C:\\Users\\48794\\Documents\\AGH\\2rok\\R\\crimes_data.rds")
Oglądam moje dane.
head(crimes, 5)
## # A tibble: 5 × 14
## uid city_name offense_code offense_type offense_group offense_against
## <int> <fct> <fct> <fct> <fct> <fct>
## 1 971488 Austin 23H all other larceny larceny/thef… property
## 2 971489 Austin 22U other burglary/br… burglary/bre… property
## 3 971490 Austin 23H all other larceny larceny/thef… property
## 4 971491 Austin 23H all other larceny larceny/thef… property
## 5 971492 Austin 250 counterfeiting/fo… counterfeiti… property
## # ℹ 8 more variables: date_single <dttm>, longitude <dbl>, latitude <dbl>,
## # location_type <fct>, location_category <fct>, census_block <chr>,
## # date_start <dttm>, date_end <dttm>
tail(crimes, 5)
## # A tibble: 5 × 14
## uid city_name offense_code offense_type offense_group offense_against
## <int> <fct> <fct> <fct> <fct> <fct>
## 1 29703980 Virginia Bea… 90Z all other o… all other of… other
## 2 29703981 Virginia Bea… 290 destruction… destruction/… property
## 3 29703982 Virginia Bea… 520 weapon law … weapon law v… society
## 4 29703983 Virginia Bea… 22A residential… burglary/bre… property
## 5 29703984 Virginia Bea… 290 destruction… destruction/… property
## # ℹ 8 more variables: date_single <dttm>, longitude <dbl>, latitude <dbl>,
## # location_type <fct>, location_category <fct>, census_block <chr>,
## # date_start <dttm>, date_end <dttm>
Z tej ramki danych, interesują mnie przestępstwa popełniane przeciwko ludziom.
persons_crimes <- crimes %>%
filter (offense_against == "persons")
Przed sprawdzeniem typów danych i braków danych, tworzę trzy nowe
kolumny: year, month, hour. Będę
ich używać w późniejszej analizie.
persons_crimes$year <- format(persons_crimes$date_single, "%Y")
persons_crimes$month <- format(persons_crimes$date_single, "%m")
persons_crimes$hour <- format(persons_crimes$date_single, "%H")
Sprawdzę teraz typ moich danych.
str(persons_crimes)
## tibble [2,196,270 × 17] (S3: tbl_df/tbl/data.frame)
## $ uid : int [1:2196270] 971498 971508 971516 971518 971523 971526 971529 971534 971544 971545 ...
## $ city_name : Factor w/ 21 levels "Austin","Boston",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ offense_code : Factor w/ 79 levels "09A","09B","100",..: 26 26 26 26 26 26 26 26 26 26 ...
## $ offense_type : Factor w/ 68 levels "aggravated assault",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ offense_group : Factor w/ 33 levels "all other offenses",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ offense_against : Factor w/ 4 levels "other","persons",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ date_single : POSIXct[1:2196270], format: "2016-01-01 00:00:00" "2016-01-01 00:00:00" ...
## $ longitude : num [1:2196270] -97.7 -97.7 -97.7 -97.7 -97.7 ...
## $ latitude : num [1:2196270] 30.4 30.3 30.2 30.4 30.3 ...
## $ location_type : Factor w/ 37 levels "abandoned","airport",..: 30 NA 30 18 30 30 30 30 NA 30 ...
## $ location_category: Factor w/ 14 levels "commercial","education",..: 9 NA 9 5 9 9 9 9 NA 9 ...
## $ census_block : chr [1:2196270] "484530018331004" "484530011001096" "484530024313003" "484530017222012" ...
## $ date_start : POSIXct[1:2196270], format: NA NA ...
## $ date_end : POSIXct[1:2196270], format: NA NA ...
## $ year : chr [1:2196270] "2016" "2016" "2016" "2016" ...
## $ month : chr [1:2196270] "01" "01" "01" "01" ...
## $ hour : chr [1:2196270] "00" "00" "00" "00" ...
Wygląda to prawie w porządku, muszę zmienić tylko typ danych w
kolumnach year, month i hour na
typ numeryczny.
persons_crimes$year <- as.numeric(persons_crimes$year)
persons_crimes$month <- as.numeric(persons_crimes$month)
persons_crimes$hour <- as.numeric(persons_crimes$hour)
Teraz wszystko jest w porządku, zajmijmy się brakami w danych.
Sprawdzam, w której kategorii i w jakiej ilości występują braki danych:
md.pattern(persons_crimes)
## uid city_name offense_code offense_type offense_group offense_against
## 371887 1 1 1 1 1 1
## 57295 1 1 1 1 1 1
## 11 1 1 1 1 1 1
## 966042 1 1 1 1 1 1
## 26929 1 1 1 1 1 1
## 205335 1 1 1 1 1 1
## 1216 1 1 1 1 1 1
## 465 1 1 1 1 1 1
## 565813 1 1 1 1 1 1
## 8 1 1 1 1 1 1
## 2 1 1 1 1 1 1
## 10 1 1 1 1 1 1
## 172 1 1 1 1 1 1
## 41 1 1 1 1 1 1
## 1 1 1 1 1 1 1
## 2 1 1 1 1 1 1
## 1041 1 1 1 1 1 1
## 0 0 0 0 0 0
## longitude latitude census_block date_single year month hour
## 371887 1 1 1 1 1 1 1
## 57295 1 1 1 1 1 1 1
## 11 1 1 1 1 1 1 1
## 966042 1 1 1 1 1 1 1
## 26929 1 1 1 1 1 1 1
## 205335 1 1 1 1 1 1 1
## 1216 1 1 1 1 1 1 1
## 465 1 1 1 1 1 1 1
## 565813 1 1 1 1 1 1 1
## 8 1 1 1 0 0 0 0
## 2 1 1 1 0 0 0 0
## 10 1 1 1 0 0 0 0
## 172 1 1 1 0 0 0 0
## 41 1 1 1 0 0 0 0
## 1 1 1 1 0 0 0 0
## 2 1 1 1 0 0 0 0
## 1041 1 1 1 0 0 0 0
## 0 0 0 1277 1277 1277 1277
## location_category location_type date_start date_end
## 371887 1 1 1 1 0
## 57295 1 1 1 0 1
## 11 1 1 0 1 1
## 966042 1 1 0 0 2
## 26929 1 0 0 0 3
## 205335 0 0 1 1 2
## 1216 0 0 1 0 3
## 465 0 0 0 1 3
## 565813 0 0 0 0 4
## 8 1 1 1 1 4
## 2 1 1 1 0 5
## 10 1 1 0 1 5
## 172 1 1 0 0 6
## 41 0 0 1 1 6
## 1 0 0 1 0 7
## 2 0 0 0 1 7
## 1041 0 0 0 0 8
## 773914 800843 1560485 1618511 4758861
Bardzo dużo braków występuje w kolumnach: date_start,
date_end. Usuwam te kolumny.
persons_crimes <- persons_crimes %>%
select (-date_start, -date_end)
Zajmijmy się zmienną date_single - braków jest
stosunkowo mało. Funkcja fill wypełnia brakujące wartości,
używając ostatniej dostępnej wartości. Analogicznie postępuję z
kolumnami year, month, hour.
persons_crimes <- persons_crimes %>% fill(date_single, year, month, hour)
Mam dużo braków w location_category oraz
location_type. Zamieniam je na other.
persons_crimes$location_category[which(is.na(persons_crimes$location_category))] = "other"
persons_crimes$location_type[which(is.na(persons_crimes$location_type))] = "other"
Ponadto usuwam kolumnę census_block, gdyż nie będę
używać jej w swojej pracy.
persons_crimes <- persons_crimes %>%
select (-census_block)
Ze względu na specyfikę i typ moich danych, nie mam w zestawie danych wartości odstających.
Możemy przejść do pracy.
W mojej pracy zajmuję się przestępstwami popełnianymi przeciwko ludziom w USA. Aby mieć lepszy obraz sytuacji, sprawdźmy, jak dużą część wszystkich przestępstw stanowią przestępstwa przeciwko ludziom.
#Podliczam ile jest rekordów w każdej z kategorii `offense_against`
crimes_data <- crimes %>%
group_by(offense_against) %>%
summarise(number = n())
ggplot(crimes_data, aes(x = "", y = number, fill = offense_against)) +
geom_bar(stat = "identity", width = 1) +
coord_polar("y") +
theme_void() +
labs(title = "Liczba przestępstw według rodzaju",
fill = "Rodzaj przestępstwa",
x = NULL,
y = NULL) +
theme(plot.title = element_text(hjust = 0.5))
Widzimy, że mówimy o mniejszości, co na swój
sposób jest pocieszającą wiadomością. Sprawdźmy jak to dokładnie wygląda
w liczbach:
sum_number_of_crimes <- sum(crimes_data$number)
crimes_data <- crimes_data %>%
mutate(percent = number*100/sum_number_of_crimes)
kable(crimes_data)
| offense_against | number | percent |
|---|---|---|
| other | 1039904 | 10.19998 |
| persons | 2196270 | 21.54228 |
| property | 5841259 | 57.29443 |
| society | 1117728 | 10.96332 |
Utwierdziliśmy się w naszych wcześniejszych przekonaniach - najwięcej jest przestępstw przeciwko własności, stanowią one ponad połowę wszystkich popełnianych przestępstw. Przestępstwa przeciwko ludziom są drugie pod względem częstości występowania.
Rozważamy dane od 2016 do 2020, Sprawdźmy, jak zmieniała się liczba przestępstw rocznie na przestrzeni tych lat.
crimes_year <- persons_crimes %>%
group_by(year) %>%
summarise(number_in_thousands = n()/1000)
ggplot(crimes_year, aes(x = year, y = number_in_thousands)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, color = "blue") + # Dopasowuje linię trendu
labs(title = "Liczba przestępstw w czasie",
y = "Liczba przestępstw w tysiącach",
x = "Data") +
coord_cartesian(ylim = c(0, max(crimes_year$number_in_thousands))) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5))
Widzimy niestety, że liczba przestępstw ma tendencję
rosnącą, a 2019 jest rokiem, w którym
przestępstw przeciwko ludziom było najwięcej.
Przyjrzyjmy się jeszcze statystykom opisowym, aby zobaczyć, jak wyglądała miesięczna liczba przestępstw w każdym roku.
persons_crimes$year_and_month <- paste(persons_crimes$year, persons_crimes$month, sep = "-")
#Tworze nowa kolumne
persons_date <- persons_crimes %>%
group_by(year_and_month) %>%
summarise(number = n()/1000)
persons_date$date <- as.Date(paste0(persons_date$year_and_month, "-01"), format = "%Y-%m-%d")
#Ta kolumna jest mi potrzebna do narysowania poźniejszego wykresu
persons_date$year <- format(persons_date$date, '%Y')
data_by_year <-persons_date %>%
group_by(year) %>%
summarise(
Mean = mean(number),
Median = median(number),
SD = sd(number),
Min = min(number),
Max = max(number)
)
kable(data_by_year)
| year | Mean | Median | SD | Min | Max |
|---|---|---|---|---|---|
| 2016 | 34.54767 | 34.8045 | 2.631264 | 29.629 | 37.752 |
| 2017 | 35.18633 | 35.6925 | 2.946477 | 29.918 | 39.115 |
| 2018 | 35.61467 | 35.5515 | 3.351230 | 29.590 | 40.421 |
| 2019 | 39.97592 | 40.2940 | 3.693789 | 32.765 | 45.044 |
| 2020 | 37.69792 | 37.8885 | 3.221716 | 32.413 | 41.822 |
Średnia miesięczna liczba przestępstw wydaje się
rosnąć z roku na rok, osiągając najwyższą wartość w
2019 roku, a następnie malejąc nieznacznie w 2020 roku.
Wzrost odchylenia standardowego odzwierciedla większą
zmienność w liczbie przestępstw na przestrzeni lat. Zakres
(różnica między Min a Max) również rośnie z roku na rok, co wskazuje na
zwiększoną zmienność między miesiącami w kolejnych
latach.
Wiemy już, że liczba przestępstw wzrasta, spójrzmy, czy któryś z miesięcy jest szczególnie niebezpiecznym.
ggplot(persons_date, aes(x = date, y = number)) +
geom_line(stat = "identity") +
labs(title = "Liczba przestępstw w miesiącu",
y = "Liczba przestępstw",
x = "Data") +
theme_minimal()+
theme(plot.title = element_text(hjust = 0.5))
Widzimy, że są miesiące, które szczególnie sprzyjają przestępczości. Sprawdźmy, które miesiące są najniebezpieczniejsze - kiedy przestępstw jest najwięcej.
persons_month <- persons_crimes %>%
group_by(month) %>%
summarise(number = n()/1000)
persons_month$name_of_month <- c("January","February","March","April","May","June", "July", "August", "September", "October", "November", "December")
persons_month$month3 <- substr(persons_month$name_of_month, start = 1, stop = 3) %>% toupper()
ggplot(persons_month, aes(x = reorder(month3, month), y = number,
color = "darkblue", fill = "lightblue")) +
geom_bar(stat = "identity") +
labs(title = "Liczba przestępstw w czasie",
y = "Liczba przestępstw w tysiącach",
x = "Miesiac") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5),
legend.position = "none")+
scale_fill_manual(values = c("lightblue" = "lightblue")) +
scale_color_manual(values = c("darkblue" = "darkblue"))
Z wykresu wynika, że najwięcej przestępstw jest popełnianych w
maju i lipcu, sprawdźmy, który z
miesięcy był najniebezpieczniejszy.
persons_month[persons_month$number == max(persons_month$number),]
## # A tibble: 1 × 4
## month number name_of_month month3
## <dbl> <dbl> <chr> <chr>
## 1 7 204. July JUL
Lipiec jest miesiącem z największą liczbą przestępstw.
Z historycznego punktu widzenia:
persons_date[persons_date$number == max(persons_date$number),]
## # A tibble: 1 × 4
## year_and_month number date year
## <chr> <dbl> <date> <chr>
## 1 2019-7 45.0 2019-07-01 2019
Lipiec 2019 roku był do tej pory najbardziej niebezpieczny.
Sprawdźmy, w którym mieście przestępstw jest najwięcej.
crimes_in_city <- persons_crimes %>%
group_by(city_name) %>%
summarise(number_of_crimes_in_thousands = n()/1000) %>%
arrange(desc(number_of_crimes_in_thousands))
ggplot(crimes_in_city, aes(y = reorder(city_name, number_of_crimes_in_thousands), x = number_of_crimes_in_thousands, fill = "darkblue")) +
geom_bar(stat = "identity") +
labs(title = "Liczba przestępstw w poszczególnych miastach",
x = "Liczba przestępstw w tysiącach",
y = "Miasto") +
theme(plot.title = element_text(hjust = 0.5),
legend.position = "none")+
scale_fill_manual(values = c("darkblue" = "darkblue"))
Z wykresu jasno widać - to Nowy York jest miastem,
w którym przestępstw jest najwięcej. Jednakże pamiętajmy, że Nowy York
jest też miastem największym. Lepiej jest więc porównywać bezpieczeństwo
w miastach na podstawie uniwersalnego współczynnika przestępczości,
który mówi nam, ile osób na 1000 to ofiary przestępstwa.
Sprawdźmy jeszcze statystyki opisowe.
summary(crimes_in_city$number_of_crimes_in_thousands)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 17.94 33.20 54.31 104.58 136.90 397.27
sd(crimes_in_city$number_of_crimes_in_thousands)
## [1] 114.3281
wsp_zmienności <- (sd(crimes_in_city$number_of_crimes_in_thousands)/mean(crimes_in_city$number_of_crimes_in_thousands))
wsp_zmienności
## [1] 1.093167
Na podstawie statystyk opisowych możemy stwierdzić, że większość miast ma niską liczbę przestępstw, jednak istnieje kilka miast, które charakteryzują się znacznie wyższą liczbą przestępstw. Stwierdzamy to ze względu na asymetrię prawostronną. Wartość współczynnika zmienności mówi nam o dużym zróżnicowaniu danych.
Spójrzmy, jak wygląda liczba przestępców na liczbę mieszkańców - biorę średnią liczbę mieszkańców z badanego okresu z każdego badanego miasta.
population <- c(8773, 2742, 3849, 631, 508, 638, 2288, 693, 964, 543, 815, 733, 674, 301, 877, 632, 923, 506, 459, 429, 480)
crimes_in_city$population_in_thousands <- population
crimes_in_city$crime_rate <- crimes_in_city$number_of_crimes_in_thousands*1000/(5*crimes_in_city$population_in_thousands)
ggplot(crimes_in_city, aes(y = reorder(city_name, crime_rate), x = crime_rate,
fill = "darkblue")) +
geom_bar(stat = "identity") +
labs(title = "Współczynnik przestępczości w poszczególnych miastach",
x = "Wartość współczynnika przestępczości",
y = "Miasto") +
theme(plot.title = element_text(hjust = 0.5),
legend.position = "none")+
scale_fill_manual(values = c("darkblue" = "darkblue"))
Największą wartość współczynnika widzimy w mieście Kansas
City, gdzie ponad 50 osób na 1000 to ofiary przestępstwa.
Dokładne dane prezentują się następująco:
kable(crimes_in_city)
| city_name | number_of_crimes_in_thousands | population_in_thousands | crime_rate |
|---|---|---|---|
| New York | 397.272 | 8773 | 9.056697 |
| Chicago | 355.972 | 2742 | 25.964406 |
| Los Angeles | 321.867 | 3849 | 16.724708 |
| Memphis | 139.544 | 631 | 44.229477 |
| Kansas City | 137.082 | 508 | 53.969291 |
| Detroit | 136.903 | 638 | 42.916301 |
| Houston | 124.321 | 2288 | 10.867220 |
| Nashville | 95.003 | 693 | 27.417893 |
| Austin | 68.151 | 964 | 14.139212 |
| Tucson | 58.436 | 543 | 21.523389 |
| San Francisco | 54.308 | 815 | 13.327117 |
| Seattle | 50.278 | 733 | 13.718417 |
| Boston | 41.339 | 674 | 12.266766 |
| St Louis | 38.841 | 301 | 25.807973 |
| Charlotte | 34.816 | 877 | 7.939795 |
| Louisville | 33.196 | 632 | 10.505063 |
| Fort Worth | 26.929 | 923 | 5.835103 |
| Mesa | 22.321 | 506 | 8.822530 |
| Virginia Beach | 21.714 | 459 | 9.461438 |
| Minneapolis | 20.036 | 429 | 9.340792 |
| Colorado Springs | 17.941 | 480 | 7.475417 |
Często słyszymy o tym, że musimy szczególnie uważać podczas nocnych spacerów, że noc jest czasem niebezpiecznym. Sprawdźmy, czy rzeczywiście przestępstwa mają przede wszystkim miejsce w nocy. W moich rozważaniach przyjmuję noc jako czas od 22 do 6.
Przedstawię, jaki procent stanowią przestępstwa wykonywane nocą dla każdego rodzaju przestępstw.
persons_crimes$time_of_day <- ifelse(persons_crimes$hour <= 6 | persons_crimes$hour >= 22, "Night", "Day")
crimes_type <- persons_crimes %>%
group_by(offense_type) %>%
summarise(
number_of_crimes = n(),
percents_of_crimes_during_night = sum(time_of_day == "Night")*100 / n()
)
ggplot(crimes_type, aes(y = reorder(offense_type, percents_of_crimes_during_night), x = percents_of_crimes_during_night)) +
geom_point(size = 2) +
labs(title = "Procent przestępstw popełnianych w noc",
x = "Procent przestępstw w nocy",
y = "Rodzaj przestępstwa") +
theme(plot.title = element_text(hjust = 0.5))
Dane mówią jasno - przestępcy nie są szczególnie aktywni
nocą. W większości kategorii to w ciągu dnia popełnia się
najwięcej przestępstw.
W celu odpowiedzenia na pytanie z tytułu przeprowadzę test chi
kwadrat.
Hipoteza główna: Zmienne są niezależne
Hipoteza alternatywna: Zmienne nie są niezależne
tabela_chi_kwadrat <- table(persons_crimes$offense_group, persons_crimes$location_category)
tabela_chi_kwadrat <- tabela_chi_kwadrat[rowSums(tabela_chi_kwadrat != 0) > 0, ] #usuwamy wiersze z samymi zerami
result_test_chi_kwadrat <- chisq.test(tabela_chi_kwadrat)
result_test_chi_kwadrat$p.value
## [1] 0
I w tym momencie możemy stwierdzić, że niezależnie od przyjętego poziomu istotności odrzucamy hipotezę główną. Zmienne nie są niezależne.
Spójrzmy jak bardzo zmienne są zależne za pomocą V-Cramera.
cramers_v <- sqrt(result_test_chi_kwadrat$statistic / sum(result_test_chi_kwadrat$observed) * (min(nrow(tabela_chi_kwadrat), ncol(tabela_chi_kwadrat)) - 1))
cramers_v
## X-squared
## 0.2380794
Mówimy o średniej zależności, którą będziemy dokładniej oglądać za chwilę.
Aby lepiej poznać sytuację spoglądam jeszcze:
result_test_chi_kwadrat$statistic
## X-squared
## 31098.32
result_test_chi_kwadrat$observed
##
## commercial education government healthcare hotel
## assault offenses 25596 24146 7348 14523 16048
## homicide offenses 99 10 3 25 66
## human trafficking 16 2 7 12 178
## kidnapping/abduction 165 142 58 25 192
## sex offenses 1270 2286 257 1594 2402
##
## leisure open space other residence retail street
## assault offenses 43028 67020 768325 685777 58360 325956
## homicide offenses 103 812 7387 1862 217 3847
## human trafficking 8 19 414 220 13 713
## kidnapping/abduction 91 463 7367 4014 215 2133
## sex offenses 1465 2512 24242 41123 1383 9431
##
## transportation vehicle
## assault offenses 27169 7160
## homicide offenses 27 359
## human trafficking 3 5
## kidnapping/abduction 91 88
## sex offenses 3474 1223
result_test_chi_kwadrat$expected
##
## commercial education government healthcare
## assault offenses 25610.53508 25082.21048 7238.990484 15263.86381
## homicide offenses 183.27909 179.49819 51.805072 109.23423
## human trafficking 19.91492 19.50409 5.629086 11.86928
## kidnapping/abduction 186.08697 182.24815 52.598738 110.90773
## sex offenses 1146.18393 1122.53909 323.976620 683.12495
##
## hotel leisure open space other
## assault offenses 17817.7472 42166.90730 66819.85404 762046.9150
## homicide offenses 127.5108 301.76302 478.18924 5453.5084
## human trafficking 13.8552 32.78926 51.95955 592.5726
## kidnapping/abduction 129.4643 306.38611 485.51521 5537.0574
## sex offenses 797.4224 1887.15431 2990.48196 34104.9466
##
## residence retail street transportation
## assault offenses 691535.3928 56783.57347 322730.8569 29023.88939
## homicide offenses 4948.9001 406.36565 2309.5893 207.70640
## human trafficking 537.7424 44.15527 250.9576 22.56916
## kidnapping/abduction 5024.7184 412.59127 2344.9728 210.88852
## sex offenses 30949.2462 2541.31432 14443.6234 1298.94653
##
## vehicle
## assault offenses 8335.264033
## homicide offenses 59.650438
## human trafficking 6.481555
## kidnapping/abduction 60.564297
## sex offenses 373.039676
Widzimy, że istnieje zależność pomiędzy rodzajem popełnianego przestępstwa, a lokalizacją, spróbujmy znaleźć tę zależność, a posłuży mi do tego mapa ciepła.
Dokonuję normalizacji danych, poprzez przekształcenie liczby przypadków przestępstw na proporcje względne, co umożliwia porównywanie wzorców zależności między zmiennymi kategorycznymi niezależnie od różnic w ogólnej liczbie przypadków, co ułatwia interpretację i porównanie zależności statystycznych.
row_normalized_table <- prop.table(tabela_chi_kwadrat, margin = 1) #normalizuję dane
pheatmap(
row_normalized_table,
color = colorRampPalette(c("white", "red"))(20),
main = 'Typ przestępstwa a lokalizacja (znormalizowane)',
fontsize = 10,
border_color = 'black',
cellwidth = 15,
cellheight = 15
)
Na podstawie wykresu mogę wysunąć wnioski:
Zastanówmy się teraz, która kategoria przestępstw jest najczęściej występującą. Spójrzmy na wykres:
crimes_type <- persons_crimes %>%
group_by(offense_group) %>%
summarise(number_of_crimes = n()/1000)
ggplot(crimes_type, aes(y = reorder(offense_group, number_of_crimes), x = number_of_crimes,
fill = "darkblue")) +
geom_bar(stat = "identity") +
labs(title = "Liczba przestępstw z poszególnych kategorii",
x = "Liczba przestępstw w tysiącach",
y = "Kategoria przestępstwa") +
theme(plot.title = element_text(hjust = 0.5),
legend.position = "none")+
scale_fill_manual(values = c("darkblue" = "darkblue"))
Nie mamy żadnych wątpliwości - najczęściej obserwujemy
napaście, później przestępstwa na tle
seksualnym, a później - porwania. Najrzadziej
zdarzają się podpalenia.
Spójrzmy teraz na to bardziej szczegółowo:
crimes_type <- persons_crimes %>%
group_by(offense_type) %>%
summarise(number_of_crimes = n()/1000)
ggplot(crimes_type, aes(y = reorder(offense_type, number_of_crimes), x = number_of_crimes,
fill = "darkblue")) +
geom_bar(stat = "identity") +
labs(title = "Liczba przestępstw z poszczególnych kategorii",
x = "Liczba przestępstw w tysiącach",
y = "Kategoria przestępstwa") +
theme(plot.title = element_text(hjust = 0.5),
legend.position = "none")+
scale_fill_manual(values = c("darkblue" = "darkblue"))
Simple assault (atak prosty) jest najczęstszym
rodzajem przestępstwa, z liczbą przypadków przekraczającą milion.
Aggravated assault (zaostrzony) również występuje
bardzo często, z ponad 587 000 przypadkami.
Nowy York kojarzy nam się jako miasto bardzo rozwinięte, Z dużą liczbą mieszkańców, kolorowymi reklamami i wysokimi budynkami. Dla wielu z nas odwiedzenie tego miasta jest marzeniem podróżniczym. Zauważyliśmy w poprzednich rozważaniach, że Nowy York jest miastem z największą liczbą przestępstw. Sprawdźmy, gdzie w Nowym Yorku jest najbezpieczniej.
persons_crimes_geo <- persons_crimes %>%
filter(city_name == "New York") %>%
select(uid, longitude, latitude)
leaflet(persons_crimes_geo) %>%
addTiles() %>%
addHeatmap(
lat = ~latitude,
lng = ~longitude,
blur = 20,
radius = 10
)
Widzimy jasno - żadna część tego miasta nie jest bez skazy i tak
naprawdę wszędzie trzeba uważać na siebie. Obszary o intensywniejszym
kolorze na heatmapie wskazują na obszary o wyższym zagęszczeniu
przestępczości.
Analiza ukazuje, że mimo rosnącej tendencji przestępczości w ostatnich latach, przestępstwa przeciwko ludziom stanowią mniejszość w porównaniu do przestępstw przeciwko własności. Nowy York wyróżnia się największą liczbą przestępstw, a Kansas City jest miastem z największą liczbą przestępstw w przeliczeniu na 1000 mieszkańców. Powinniśmy uważać na siebie o każdej porze doby, a lipiec okazał się miesiącem, gdzie liczba popełnianych przestępstw jest największa. Zależności między rodzajem przestępstwa a miejscem jego popełnienia są zauważalne, a analiza danych geograficznych dla Nowego Jorku ukazuje, że bezpieczne obszary są relatywnie rzadkie. Analiza wykazała, że atak prosty (simple assault) jest bezkonkurencyjnie najczęściej występującym rodzajem przestępstwa, przekraczającym liczbę miliona przypadków. Zrozumienie i skuteczne zarządzanie tymi zjawiskami może przyczynić się do poprawy ogólnego bezpieczeństwa społeczeństwa.